perm filename PASS4[901,BGB] blob sn#129620 filedate 1974-11-12 generic text, type T, neo UTF8
00040	TITLE PASS4
00044	EXTERNAL NUMTRI,OUTPDL,TRITAB,ENDPDL
00046	INTERNAL PASS4
00050	OPDEF OUTSTR[XWD 5114,0]
00100	;USE AND ABUSE OF ACCUMULATORS
00140	A←←0
00200	AC0←←0
00300	AC1←←1
00340	AC2←←2
00400	XM←←0
00500	YM←←1
00600	
00700	XL←2
00800	XH←3
00900	YL←4
01000	YH←5
01100	
01200	X1←AA←←6
01300	X2←BB←←7
01400	X3←CC←←10
01500	
01600	Y1←MINZ←←11
01700	Y2←MAXZ←←12
01800	Y3←13
01900	
02000	AB←←14
02100	C←←15
02200	
02300	T←16
02400	TT←17
02500	KPLANE←20000
     

00100	;THE OCCULT LINE ELIMINATOR
00200	PASS4:	0
00300		MOVEI  A,OUTPDL+1
00400		MOVEM A,OUTPDL
00500		MOVEI A,SQRPDL+4
00600		MOVEM A,SQRPDL
00700		MOVE A,[XWD -1000,1000]
00800		MOVEM A,SQRPDL+1
00900		MOVEM A,SQRPDL+2
01000		MOVEI A,377777
01100		MOVEM A,SQRPDL+3
01200	
01300	;MAIN LOOP
01400	MALOOP:	MOVEI ENDPDL
01450		SUB OUTPDL
01475		SKIPG
01487		JRST @PASS4	;EXIT OUTPUT BUFFER FULL.
01493		SOS AC1,SQRPDL
01500		CAIG AC1,SQRPDL
01600		JRST @PASS4		;EXIT NO MORE WINDOWS
01700		MOVE YH,@SQRPDL		;PICKUP NEXT WINDOW
01800		SOS      SQRPDL
01900		MOVE YL,@SQRPDL
02000		SOS      SQRPDL
02100		MOVE XL,@SQRPDL
02200		HRREM YH,ZH		;SETUP WINDOW IN ACCUMULATORS
02300		HRREM YL,YH
02400		HRREM XL,XH
02500		HLRES XL
02600		HLRES YL
02700		MOVEI AC0,PLIST+1	;CLEAR PLIST & SLIST
02800		MOVEM AC0,PLIST
02900		MOVEI AC0,SLIST+1
03000		MOVEM AC0,SLIST
03100		HRL TT,NUMTRI
03200		MOVNS TT
03300		HRRI TT,TRITAB-1
     

00100	;CALVALCADE OF SHORT MACRO DEFINITIONS
00200	
00300	DEFINE OLDNEW
00400	{	MOVE AC0,VOLOLD
00500		MOVEM AC0,VOLNEW
00600		MOVE AC0,VOLOLD+1
00700		MOVEM AC0,VOLNEW+1
00800	⎇
00900	
01000	DEFINE VOLMOV (V1,V2)
01100	{	MOVE AC0,V1
01200		MOVEM AC0,V2
01300		MOVE AC0,V1+1
01400		MOVEM AC0,V2+1
01500	⎇
01600	
01700	DEFINE BFC (B,F,C)
01800	{	MOVE AC1,VOLOLD+1
01900		CAMG AC1,VOLNEW
02000		JRST B
02100		MOVE AC1,VOLNEW+1
02200		CAMG AC1,VOLOLD
02300		JRST F
02400		JRST C
02500	⎇
02600	
02700	DEFINE VOLCOM
02800	{	MOVE AC0,VOLOLD
02900		CAMGE AC0,VOLNEW
03000		MOVEM AC0,VOLNEW
03100		MOVE AC0,VOLOLD+1
03200		CAMLE AC0,VOLNEW+1
03300		MOVEM AC0,VOLNEW+1
03400	⎇
03500	
03600	DEFINE SCAN (EXIT1,EXIT2,EXIT3,EXIT4,EXITN){
03700		JSR PNS
03800		JRST [BFC ({[OLDNEW
03900			     JRST .-1]⎇,{EXIT1⎇,{EXIT2⎇)]
04000		JRST EXITN
04100		BFC ({[OLDNEW
04200		       JRST .-5]⎇,{EXIT4⎇,{EXIT3⎇)
04300	⎇
     

00100	;SCAN FOR FIRST TRIANGLE
00200		JSR PNS
00300		JRST ONEPEN	;P
00400		JRST MALOOP	;N
00500	
00600	;ONE SURROUNDER
00700	ONESUR:	SCAN ({[OLDNEW
00800		        JRST PANDS]⎇,ALPHA,TWOSUR,ONESUR,MALOOP)
00900	
01000	;TWO SURROUNDERS
01100	TWOSUR:	VOLMOV VOLNEW,VOL1
01200		VOLMOV VOLOLD,VOL2
01300		VOLCOM
01400		SCAN (ALPHA,ALPHA,{[
01500		VOLMOV VOL1,VOLOLD
01600		BFC (TWOSUR,TWOSUR,{[
01700		VOLMOV VOL2,VOLOLD
01800		BFC (TWOSUR,TWOSUR,ALPHA)
01900		]⎇)]⎇,ONESUR,GAMMA)
02000	
02100	;ONE PENETRATOR
02200	ONEPEN:	JSR PNS
02300		JRST TWOPEN	;P
02400		JRST BETA	;N
02500	NEWSUR:	BFC (PANDS,ONESUR,ALPHA)	;S FOR NEW SURROUNDER
02600	
02700	;A PENETRATOR AND A SURROUNDER
02800	PANDS:	VOLMOV VOLOLD,VOL3
02900		SCAN (TWOPEN,ALPHA,{[
03000		VOLMOV VOL3,VOLOLD
03100		JRST NEWSUR]⎇,ALPHA,BETA)
03200	
03300	;TWO PENETRATORS
03400	TWOPEN:	
     

00100	;SPLIT UP THE WINDOW EXIT
00200	ALPHA:	MOVE XM,XL
00300		MOVE YM,YL
00400		ADD  XM,XH
00500		ADD  YM,YH
00600		ASH  XM,-1
00700		ASH  YM,-1
00710		;RESOLUTION EXIT
00720		CAMN XL,XM
00730		JRST MALOOP
00740		CAMN XH,XM
00750		JRST MALOOP
00800		MOVE AB,ZL
00900		MOVE C,ZH
01000	DEFINE SQPR(A,B){
01100		HRLM A,@SQRPDL
01200		HRRM B,@SQRPDL
01300		AOS SQRPDL
01400	⎇
01405	
01410		MOVE AA,SQRPDL
01415		ADDI AA,14
01420		CAIL AA,SQREND
01425		JRST [OUTSTR [ASCIZ/SQUARE PDL OVERFLOW.
01430	/]
01435	HALT]
01500		SQPR XL,XM
01600		SQPR YL,YM
01700		SQPR AB,C
01900		SQPR XM,XH
02000		SQPR YL,YM
02100		SQPR AB,C
02300		SQPR XL,XM
02400		SQPR YM,YH
02500		SQPR AB,C
02700		SQPR XM,XH
02800		SQPR YM,YH
02900		SQPR AB,C
03100		JRST MALOOP
03200	
03300	;DISPLAY OUTPUT ONE-PENETRATOR
03400	BETA:	MOVE AC0,XH
03500		SUB  AC0,XL
03600		HRLM AC0,@OUTPDL
03700		MOVE AC1,PENNEW
03800		HRRM AC1,@OUTPDL
03900		AOS  OUTPDL
04000		HRLM XL,@OUTPDL
04100		HRRM YL,@OUTPDL
04200		AOS  OUTPDL
04300		JRST MALOOP
04400	
04500	;DISPLAY OUTPUT TWO-SURROUNDERS
04600	GAMMA:	MOVE AC0,XH
04700		SUB  AC0,XL
04800		TRO  AC0,400000
04900		HRLM AC0,@OUTPDL
05000		MOVE AC1,SURNEW
05100		HRRM AC1,@OUTPDL
05110		AOS OUTPDL
05120		HRLM XL,@OUTPDL
05130		HRRM YL,@OUTPDL
05200		AOS  OUTPDL
05300		MOVE AC1,SUROLD
05400		HRRZM AC1,@OUTPDL
05500		AOS  OUTPDL
05600		JRST MALOOP
     

00200	;		Scan triangle list for the next triangle that either
00300	;penetrates or surrounds the window and then calculate the occupation
00400	;volume;     If a penetrator, then returns in sequence
00500	;	    If no triangle found,  then skips a word
00600	;	    If surrounder found,  then skips two words.
00700	
00800	PNS:	0
00900	;GET POINTER TO NEXT TRIANGLE IF LIST IS EMPTY OR TRIANGLE IS BEYOND
01000	;BACK LIMIT THEN TAKE THE NIL EXIT.
01100	PNS1:	AOBJP TT,[AOS PNS ↔ JRST @PNS]
01200		HRRZ T,(TT)
01300		HLRE AC0,(TT)
01400		CAML AC0,ZH
01500		JRST @PNS1
01502	
01504	;GET TRIANGLE COORDINATES INTO ACCUMULATORS
01506		HLRE X1,0(T)
01508		HLRE X2,1(T)
01510		HLRE X3,2(T)
01512		HRRE Y1,0(T)
01514		HRRE Y2,1(T)
01516		HRRE Y3,2(T)
01518	
01600	
01800	;	If all corners of the triangle are to one side of the window
01900	;then that triangle is outside and the scan proceeds to the next.
02000	DEFINE OUTSIDE $ (M,N,P,HL){
02100	CAM$M P$HL,P$1 ↔ JRST .+5
02200	CAM$M P$HL,P$2 ↔ JRST .+3
02300	CAM$N P$HL,P$3 ↔ JRST PNS1 ⎇
02400	OUTSIDE LE,G,X,H
02500	OUTSIDE LE,G,Y,H
02600	OUTSIDE GE,L,X,L
02700	OUTSIDE GE,L,Y,L
02800	
03000	;	If any corner of the triangle is within the window then it
03100	;is a penetrator.  Dirty commie penetraitor !
03200	FOR @$ N←1,3 
03250	{
03400	CAMLE X$N,XH    ↔ JRST .+7
03500	CAMLE XL,X$N    ↔ JRST .+5
03600	CAMLE Y$N,YH    ↔ JRST .+3
03700	CAMG  YL,Y$N    ↔ JRST PENF$N
03800	⎇
03900	
     

00100	;TEST FOR SURROUNDER
00200	
00400	;		For each edge of the triangle, For each corner of the
00500	;square, If qqq is the same sign then the edge does not pass
00600	;thru the square and if the odd vertex opposite that edge is on the side opposite
00700	;the square then the triangle is outside of the window, else you must continue
00800	;If all twelve qqq's have the same sign then the triangle is a surrounder else it
00900	;is a dirty commie penetraitor.
01000	
01100	;Q PARAMETER COMPUTED
01200	DEFINE QQQ(N,M){
01300		HLRE AC1,AB ↔ HRRE AC0,AB
01400		IMUL AC1,IFN(N∧4),<3+> XL+(N∧1)+M
01500		IMUL AC0,YL+((N∧2)⊗-1)+(N∧4)+M
01600		ADD AC1,AC0 ↔ ADD AC1,C
01700	⎇
01800	
01900	FOR @$ I←1,3
01950	{			;EDGES
02000	MOVE AB,5+I(T)
02100	IFE (I-1),<HLRE C,5(T)>		;GET LINE COEF
02200	IFE (I-2),<HRRE C,5(T)>
02300	IFE (I-3),<HRRE C,12(T)>
02400	QQQ 0,0 ↔ HLL T,AC1		;FIRST CORNER
02500	
02600	FOR J←1,3
02650	{			;OTHER CORNERS
02700	QQQ J,0
02800	EQV AC1,T
02900	SKIPL AC1
03000	JRST FOO$I
03100	⎇
03200	QQQ 4,I				;ODD VERTEX
03300	EQV AC1,T
03400	SKIPL AC1
03500	JRST PNS1			;TRIANGLE OUTSIDE OF WINDOW
03600	SKIPA X$I,T			;SAVE QQQ's SIGN
03800	
03900	;DEAD ON ARRIVAL HERE,  CAN NO LONGER BE A SURROUNDER
04000	FOO$I:	SETZ X$I,
04100	⎇
04200	
04300	;FINAL RECKONING
04400	SKIPN X1 ↔ JRST PENF2	;IF ANY ZEROES THEN PENETRATOR
04500	SKIPN X2 ↔ JRST PENF2
04600	SKIPN X3 ↔ JRST PENF2
04900	
     

05000	;YIPPIE !   FOUND A SURROUNDER.   For those of you who may have gotten
05100	; lost, surrounders are the things that do the hiding in the hidden line
05200	;  algorithm.
05300		HLLI T,
05400		MOVEI AC0,2
05500		ADDM AC0,PNS	;DOUBLE SKIP ON FINAL EXIT
05600		MOVEM T,@SLIST
05700		AOS SLIST
05800		EXCH T,SURNEW
05900		MOVEM T,SUROLD
06000		MOVE T,SURNEW
06100		JSR OCCVOL	;COMPUTE OCCUPATION VOLUME
06200		MOVE AC0,VOLNEW+1
06300		CAMGE AC0,ZH	;LOWER THE BACK LIMIT
06400		MOVEM AC0,ZH
06500		JRST @PNS
06600	
06700	;PENETRATOR FOUND.
06900	PENF1:	CAMLE X3,XH   ↔ JRST PENF2	;WITHIN THE WINDOW THEN BYPASS
07000		CAMLE XL,X3   ↔ JRST PENF2	;THE LONGER OCCUPATION VOLUME ROUTINE.
07100		CAMLE Y3,YH   ↔ JRST PENF2
07200		CAMLE YL,Y3   ↔ JRST PENF2
07300	
07400		HLRE AC0,3(T)			;SHORT OCCUPATION VOLUME ROUTINE.
07500		HLRE AC1,4(T)
07600		EXCH AC0,VOLNEW
07700		EXCH AC1,VOLNEW+1
07800		MOVEM AC0,VOLOLD
07900		MOVEM AC1,VOLOLD+1
08000		JRST PENF3+1
08100	PENF2:
08200	PENF3:	HLLI T,
08250		JSR OCCVOL
08300		MOVEM T,@PLIST
08400		AOS PLIST
08500		EXCH T,PENNEW
08600		MOVEM T,PENOLD
08700		MOVE T,PENNEW
08800		JRST @PNS
     

00100	;OCCUPATION VOLUME
00200	
00400	;		Compute the occupation volume ofthe Triangle pointed
00500	;to by T for the window XL XH YL YH, find the minimum and maximum Z for all
00600	;corners of the window without exceeding the triangle's total volume z1
00700	;minimum to z3 maximum; if you are worth anything you have by now realized
00800	;that this will yield too large a volume for numerous penetrator cases
00900	;where the vertices aren't in the window and the corners aren't in the triangle
01000	;but it doesn't matter and will all come out correctly further along.
01100	
01200	OCCVOL:	0
01300		HLRE AA,11(T)
01400		HRRE BB,11(T)
01500		HLRE CC,12(T)		;PICKUP COEF OF TRIANGLE'S PLANE
01600		HRLZI MAXZ,400000	;Z1
01700		SETCAM MAXZ,MINZ		;Z3
01800	
01900	FOR I←0,3 
01950	{
02000	MOVEI AC0,KPLANE
02100	MOVE AC1,XL+(I∧1)
02200	IMUL AC1,AA
02300	SUB AC0,AC1
02400	MOVE AC1,YL+((I∧2)⊗-1)
02500	IMUL AC1,BB
02600	SUB AC0,AC1
02700	IDIV AC0,CC
02800	CAMGE AC0,MINZ
02900	MOVE MINZ,AC0
03000	CAMLE AC0,MAXZ
03100	MOVE MAXZ,AC0
03200	⎇
03300	HLRE AC0,3(T)
03400	HLRE AC1,4(T)
03500	CAMLE AC0,MINZ
03600	MOVE MINZ,AC0
03700	CAMGE AC1,MAXZ
03800	MOVE MAXZ,AC1
03900	
04000	EXCH MINZ,VOLNEW
04100	EXCH MAXZ,VOLNEW+1
04200	MOVEM MINZ,VOLOLD
04300	MOVEM MAXZ,VOLOLD+1
04400	
04500	JRST @OCCVOL
     

00100	;PASS4 WORK AREA
00200	VOLOLD:	0	↔	0
00300	VOLNEW:	0	↔	0
00400	VOL1:	0	↔	0
00500	VOL2:	0	↔	0
00600	VOL3:	0	↔	0
00700	ZL:	0
00800	ZH:	0
01200	SQRPDL:	.+4	;WINDOW SQUARE IN CORE PUSHDOWN LIST
01300		0	; XL XH
01400		0	; YL YH
01500		0	; ZL ZH
01600		BLOCK 3000
01650	SQREND:
01900	PLIST:	0	;PENETRATOR LIST
02000		BLOCK 20
02100		
02200	SLIST:	0	;SURROUNDERS LIST
02300		BLOCK 10
02400	PENOLD:	0
02500	PENNEW:	0
02600	SUROLD:	0
02700	SURNEW:	0
02800	END